COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare (special size classmax typemax d)
C00008 ENDMK
C⊗;
(declare (special size classmax typemax d)
	 (fixnum (place fixnum fixnum)
		 size classmax typemax d))

;(defmacro tab () '(tyo 9.))

(setq true t false ())
(declare (setq true t false ()))

(setq size 511.)
(setq classmax 3.)
(setq typemax 12.)
(setq d 8.)

(declare (special iii kount)
	 (fixnum iii i j k kount m n))

(declare (array* (fixnum piececount 1 class 1 piecemax 1)
		 (notype puzzle 1 p 2)))

(array piececount fixnum (1+ classmax))
(array class fixnum (1+ typemax))
(array piecemax fixnum (1+ typemax))
(array puzzle t (1+ size))
(array p t (1+ typemax) (1+ size))

(defun fit (i j)
 (let ((end (piecemax i)))
      (do ((k 0 (1+ k)))
	  ((> k end) #.true)
	  (cond ((p i k)
		 (cond ((puzzle (+ j k))
			(return #.false))))))))

(defun place (i j)
       (let ((end (piecemax i)))
	    (do ((k 0 (1+ k)))
		((> k end))
		(cond ((p i k) 
		       (store (puzzle (+ j k)) #.true))))
		 (store (piececount (class i)) (- (piececount (class i)) 1))
	    (do ((k j (1+ k)))
		((> k size)

;		 (terpri)
;		 (princ "Puzzle filled") 

		 0)
		(cond ((not (puzzle k))
		       (return k))))))

(defun remove (i j)
       (let ((end (piecemax i)))
	    (do ((k 0 (1+ k)))
		((> k end))
		(cond ((p i k) (store (puzzle (+ j k)) #.false))))
	    (store (piececount (class i)) (+ (piececount (class i)) 1))))

(defun trial (j)
       (let ((k 0))
	    (do ((i 0 (1+ i)))
		((> i typemax) (setq kount (1+ kount)) 
			       #.false)
		(cond ((not (= (piececount (class i)) 0))
		       (cond ((fit i j)
			      (setq k (place i j))
			      (cond ((or (trial k)
					 (= k 0))

;				     (terpri)
;				     (princ "Piece") (tab)
;				     (princ (+ i 1)) (tab)
;				     (princ "at")(tab)(princ (+ k 1))

				     (setq kount (+ kount 1))
				     (return #.true))
				    (t (remove i j))))))))))

(defun definepiece (iclass ii jj kk)
       (let ((index 0))
	    (do ((i 0 (1+ i)))
		((> i ii))
		(do ((j 0 (1+ j)))
		    ((> j jj))
		    (do ((k 0 (1+ k)))
			((> k kk))
			(setq index  (+ i (* d (+ j (* d k)))))
			(store (p iii index) #.true))))
	    (store (class iii) iclass)
	    (store (piecemax iii) index)
	    (cond ((not (= iii typemax))
		   (setq iii (+ iii 1))))))

(defun start ()
       (do ((m 0 (1+ m)))
	   ((> m size))
	   (store (puzzle m) #.true)) 
       (do ((i 1 (1+ i)))
	   ((> i 5))
	   (do ((j 1 (1+ j)))
	       ((> j 5))
	       (do ((k 1 (1+ k)))
		   ((> k 5))
		   (store (puzzle (+ i (* d (+ j (* d k))))) #.false))))
       (do ((i 0 (1+ i)))
	   ((> i typemax))
	   (do ((m 0 (1+ m)))
	       ((> m size))
	       (store (p i m) #.false)))
       (setq iii 0)
       (definePiece 0 3 1 0)
       (definePiece 0 1 0 3)
       (definePiece 0 0 3 1)
       (definePiece 0 1 3 0)
       (definePiece 0 3 0 1)
       (definePiece 0 0 1 3)

       (definePiece 1 2 0 0)
       (definePiece 1 0 2 0)
       (definePiece 1 0 0 2)

       (definePiece 2 1 1 0)
       (definePiece 2 1 0 1)
       (definePiece 2 0 1 1)

       (definePiece 3 1 1 1)

       (store (pieceCount 0) 13.)
       (store (pieceCount 1) 3)
       (store (pieceCount 2) 1)
       (store (pieceCount 3) 1)
       (let ((m (+ 1 (* d (+ 1 d))))
	     (n 0)(kount 0))
	    (cond ((fit 0 m) (setq n (place 0 m)))
		  (t (terpri)(princ "Error")))
	    (cond ((trial n) 
		   (terpri)(princ "success in ")(princ kount) (princ " trials")) 
		  (t (terpri)(princ "failure"))) 
	    (terpri)))

(defun timit ()
       ((lambda (t1 x gt)
		(start)
		(setq t1 (- (runtime) t1))
		(setq gt (- (status gctime) gt))
		(print (list 'runtime
			     (//$ (float  (- t1 gt))
				  1000000.0)))
		(print (list 'gctime
			     (//$ (float gt) 1000000.0))))
	(runtime) ()(status gctime)))